home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / put-1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-20  |  6.5 KB  |  356 lines
  1. {
  2.  ******************************************************************************
  3.  * PUT-1 - 'Put' function demo.                              *
  4.  *                                          *
  5.  * Written for GRAFIX by:  Joseph A. Albrecht                      *
  6.  *                                          *
  7.  * Press F10 to toggle between 320 and 640 graphic modes              *
  8.  * Press ESC to exit program                              *
  9.  ******************************************************************************
  10. }
  11.  
  12. PROGRAM PutDemo1;
  13.  
  14. USES
  15.   Crt,
  16.   Grafix;
  17.  
  18. VAR
  19.   Graphics, BoxStep, BoxWidth, B, C, I, J, K, M, N, P, X, Y, X1: INTEGER;
  20.   Box: ARRAY[0..138] OF WORD;
  21.   Color: ARRAY [0..15] OF STRING[10];
  22.   Method: ARRAY [1..5] OF STRING[6];
  23.   Ch: CHAR;
  24.   EndProgram, Loop, Tandy11, NextColor: BOOLEAN;
  25.  
  26. PROCEDURE ShowPreset;
  27.  
  28. BEGIN
  29.  
  30.  ExtPut(X, Y, Box[0], PutPreset);
  31.  
  32. END;
  33.  
  34. PROCEDURE ShowPset;
  35.  
  36. BEGIN
  37.  
  38.   ExtPut(X, Y, Box[0], PutPset);
  39.  
  40. END;
  41.  
  42. PROCEDURE ShowAnd;
  43.  
  44. BEGIN
  45.  
  46.   ExtPut(X, Y, Box[0], PutAnd);
  47.  
  48. END;
  49.  
  50. PROCEDURE ShowOr;
  51.  
  52. BEGIN
  53.  
  54.   ExtPut(X, Y, Box[0], PutOr);
  55.  
  56. END;
  57.  
  58. PROCEDURE ShowXor;
  59.  
  60. BEGIN
  61.  
  62.   ExtPut(X, Y, Box[0], PutXor);
  63.  
  64. END;
  65.  
  66. PROCEDURE PrintNames;
  67.  
  68. BEGIN
  69.  
  70.   SetCursor(N * 2 + 6, 2);
  71.   PrintStringX(Method[N]);
  72.   FOR P := 1 TO 12 - Length(Method[N]) DO
  73.     PrintStringX('.');
  74.   PrintString(Chr(N + 48));
  75.  
  76. END;
  77.  
  78. PROCEDURE DrawBoxes;
  79.  
  80. BEGIN
  81.  
  82.   IF Graphics = 320 THEN
  83.     BEGIN
  84.       FillBox(129, 4, 319, 195, Black);
  85.       DrawBox(129, 4, 319, 195, Red);
  86.     END
  87.   ELSE
  88.     BEGIN
  89.       FillBox(129, 4, 639, 195, Black);
  90.       DrawBox(129, 4, 639, 195, Red);
  91.     END;
  92.    SetPlotColor(Red);
  93.    ExtLine(4, 24, 124, 24);
  94.    IF Graphics = 320 THEN
  95.      X1 := 137
  96.    ELSE
  97.      X1 := 172;
  98.    X := X1;
  99.    Y := 12;
  100.    K := 0;
  101.    FOR I := 1 TO 4 DO
  102.      BEGIN
  103.        FOR J := 1 TO 4 DO
  104.      BEGIN
  105.        FillBox(X, Y, X + BoxWidth, Y + 31, K);
  106.        IF K = 0 THEN
  107.          DrawBox(X, Y, X + BoxWidth, Y + 31, DarkGray);
  108.         X := X + BoxStep;
  109.         Inc(K);
  110.      END;
  111.        X := X1;
  112.        Y := Y + 48;
  113.      END;
  114.  
  115. END;
  116.  
  117. PROCEDURE SwitchGraphics;
  118.  
  119. BEGIN
  120.  
  121.   IF Tandy11 = True THEN
  122.     BEGIN
  123.       Loop := False;
  124.       IF Graphics = 320 THEN
  125.     BEGIN
  126.       Graphics := 640;
  127.       BoxStep := 120;
  128.       BoxWidth := 62;
  129.       HighGraphics;
  130.     END
  131.       ELSE
  132.     BEGIN
  133.       Graphics := 320;
  134.       BoxStep := 48;
  135.       BoxWidth := 31;
  136.       MediumGraphics;
  137.     END;
  138.     END;
  139.  
  140. END;
  141.  
  142. PROCEDURE ExitProgram;
  143.  
  144. BEGIN
  145.  
  146.   ExitGraphics;
  147.   Halt(0);
  148.  
  149. END;
  150.  
  151. {Mainline}
  152. BEGIN
  153.  
  154.   Color[0] := 'BLACK';
  155.   Color[1] := 'BLUE';
  156.   Color[2] := 'GREEN';
  157.   Color[3] := 'CYAN';
  158.   Color[4] := 'RED';
  159.   Color[5] := 'MAGENTA';
  160.   Color[6] := 'BROWN';
  161.   Color[7] := 'LT GREY';
  162.   Color[8] := 'GREY';
  163.   Color[9] := 'LT BLUE';
  164.   Color[10] := 'LT GREEN';
  165.   Color[11] := 'LT CYAN';
  166.   Color[12] := 'LT RED';
  167.   Color[13] := 'LT MAGENTA';
  168.   Color[14] := 'YELLOW';
  169.   Color[15] := 'WHITE';
  170.  
  171.   Method[1] := 'PRESET';
  172.   Method[2] := 'PSET';
  173.   Method[3] := 'AND';
  174.   Method[4] := 'OR';
  175.   Method[5] := 'XOR';
  176.  
  177.   Graphics := 320;
  178.   BoxStep := 48;
  179.   BoxWidth := 31;
  180.   EndProgram := False;
  181.   Loop := True;
  182.   NextColor := False;
  183.   GetTandy11(Tandy11);
  184.   MediumGraphics;
  185.  
  186. {Again}
  187.   WHILE EndProgram = False DO
  188.     BEGIN
  189.       ClearScreen;
  190.       SetTextColor(Yellow);
  191.       DrawBoxes;
  192.       SetTextColor(Brown);
  193.       SetCursor(5, 5);
  194.       PrintString('ACTION:');
  195.       FOR N := 1 TO 5 DO
  196.     PrintNames;
  197.       SetTextColor(LightCyan);
  198.       PrintString(' ');
  199.       PrintString(' Enter number ' + Chr(24));
  200.       PrintString(' ');
  201.       PrintString('       or');
  202.       PrintString(' ');
  203.       PrintString(' press <Return>');
  204.       PrintString(' ');
  205.       PrintStringX(' for next color');
  206.  
  207. {MainLoop}
  208.       WHILE Loop = True DO
  209.     BEGIN
  210.       SetTextColor(Yellow);
  211.       SetCursor(2, 1);
  212.       PrintStringX('                ');
  213.       SetCursor(2, 2);
  214.       PrintStringX('Color (0-F) ');
  215.       C := -1;
  216.       ClearKey;
  217.       Ch := #255;
  218.       WHILE (C < 0) OR (C > 15) DO
  219.         BEGIN
  220.           Ch := ReadKey;
  221.           IF Ch = #00 THEN
  222.         Ch := ReadKey;
  223.           IF Ch = #68 THEN
  224.         BEGIN
  225.           SwitchGraphics;
  226.           C := 0;
  227.         END;
  228.           Ch := UpCase(Ch);
  229.           CASE Ch OF
  230.         'A'..'F': C := Ord(Ch) - 55;
  231.         '0'..'9': C := Ord(Ch) - 48;
  232.         #27: ExitProgram;
  233.           ELSE
  234.         C := -1;
  235.           END;
  236.         END;
  237.       IF Loop = True THEN
  238.         BEGIN
  239.           SetCursor(2, 1);
  240.           PrintStringX('                ');
  241.           DrawBoxes;
  242.           IF Graphics = 320 THEN
  243.         BEGIN
  244.           FillBox(1, 1, 16, 16, C);
  245.           ExtGet(1, 1, 16, 16, Box[0]);
  246.           ExtPut(1, 1, Box[0], PutXor);
  247.         END
  248.           ELSE
  249.         BEGIN
  250.           FillBox(1, 1, 31, 16, C);
  251.           ExtGet(1, 1, 31, 16, Box[0]);
  252.           ExtPut(1, 1, Box[0], PutXor);
  253.         END;
  254.           IF C = 0 THEN
  255.         SetTextColor(DarkGray)
  256.           ELSE
  257.         SetTextColor(C);
  258.           SetCursor(2, (8 - Length(Color[C]) DIV 2));
  259.           PrintStringX(Color[C]);
  260.           ClearKey;
  261.           N := 0;
  262.           Ch := #255;
  263.           WHILE ((N < 1) OR (N > 5)) DO
  264.         BEGIN
  265.           Ch := ReadKey;
  266.           IF Ch = #0 THEN
  267.             Ch := ReadKey;
  268.           N := Ord(Ch) - 48;
  269.           IF Ch = #13 THEN
  270.             BEGIN
  271.               SetCursor(2, 3);
  272.               PrintStringX('          ');
  273.               NextColor := True;
  274.               N := 1;
  275.             END;
  276.           IF Ch = #27 THEN
  277.             ExitProgram;
  278.           IF Ch = #68 THEN
  279.             SwitchGraphics;
  280.             N := 1;
  281.         END;
  282.         END;
  283.  
  284. {NextAction}
  285.       WHILE (Loop = True) AND (NextColor = False) DO
  286.         BEGIN
  287.           SetTextColor(Yellow);
  288.           FOR B := 1 TO 3 DO
  289.          BEGIN
  290.            SetCursor(N * 2 + 6, 2);
  291.            PrintStringX('              ');
  292.            Pause(8);
  293.            PrintNames;
  294.            Pause(8);
  295.          END;
  296.           IF Graphics = 320 THEN
  297.         X1 := 145
  298.           ELSE
  299.         X1 := 188;
  300.           X := X1;
  301.           Y := 20;
  302.           K := 0;
  303.           FOR I := 1 TO 4 DO
  304.         BEGIN
  305.           FOR J := 1 TO 4 DO
  306.             BEGIN
  307.               CASE N OF
  308.              1: ShowPreset;
  309.              2: ShowPset;
  310.              3: ShowAnd;
  311.              4: ShowOr;
  312.              5: ShowXor;
  313.               END;
  314.               X := X + BoxStep;
  315.               Inc(K);
  316.             END;
  317.           X := X1;
  318.           Y := Y + 48;
  319.         END;
  320.         M := 0;
  321.         Ch := #255;
  322.         ClearKey;
  323.         WHILE (M < 1) OR (M > 5) DO
  324.           BEGIN
  325.             Ch := ReadKey;
  326.             IF Ch = #00 THEN
  327.               Ch := ReadKey;
  328.              M := Ord(Ch) - 48;
  329.              IF Ch = #13 THEN
  330.                BEGIN
  331.              NextColor := True;
  332.              Loop := False;
  333.              M := 1;
  334.                END;
  335.              IF Ch = #27 THEN
  336.                ExitProgram;
  337.              IF Ch = #68 THEN
  338.                BEGIN
  339.              SwitchGraphics;
  340.              M := 1;
  341.                END;
  342.           END;
  343.           SetTextColor(Brown);
  344.           PrintNames;
  345.           DrawBoxes;
  346.           N := M;
  347.           IF Loop = True THEN
  348.         NextColor := False;
  349.         END;
  350.       NextColor := False;
  351.     END;
  352.       Loop := True;
  353.     END;
  354.  
  355. END.
  356.